home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / diskmags / 0022-3.564 / dmg-3323 / protocol.gem / gfa / acc_400.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1987-04-21  |  10KB  |  326 lines
  1. ' ACC 400
  2. ' Accessoire possédant un menu déroulant GEM
  3. ' Ce menu déroulant sera géré par le programme principal
  4. '
  5. ' Les équivalences issues du fichier ressource
  6. LET menu1&=0             ! menu tree
  7. LET desk400&=3           !TITLE in tree MENU1
  8. LET files400&=4          !TITLE in tree MENU1
  9. LET tests400&=5          !TITLE in tree MENU1
  10. LET about400&=8          !STRING in tree MENU1
  11. LET quit400&=18          !STRING in tree MENU1
  12. LET hello400&=20         !STRING in tree MENU1
  13. LET check400&=21         !STRING in tree MENU1
  14. '
  15. $m 10000                ! petite réservation
  16. my_menu$="  ACC400/GFA" ! titre du menu de cet ACC
  17. ' Les définitions des alertes
  18. alert1$="[1][ACC_400, Accessoire avec|un vrai menu GEM!|Compatible Protocole!][ OK ]"
  19. alert2$="[1][J'espère que vous allez|utiliser le protocole|dans vos programmes!][Ah oui!]"
  20. alert3$="[1][Pas d'application|acceptant mon menu...][Dommage!]"
  21. alert4$="[1][Ressource introuvable|(ACC_400.RSC)][Bye bye]"
  22. alerte_tub1$="[1][Tableau endommagé, |communication par le|Tube GEM impossible.][ OK ]"
  23. alerte_tub3$="[1][Probléme en $5A0 |Communication par le|Tube GEM impossible][ OK ]"
  24. '
  25. ' Préparons les buffers
  26. DIM new_jar%(31)        ! pour le Cookie-jar
  27. DIM tab_tub&(13)        ! pour le tableau Protocole
  28. DIM messagebuf&(7)      ! pour émettre et recevoir les messages
  29. '
  30. flag_check&=0   !check du menu déroulant
  31. '
  32. app_id&=APPL_INIT()     ! je demande mon identificateur d'application
  33. IF RSRC_LOAD("\ACC_400.RSC")=0
  34.   ~FORM_ALERT(1,alert4$)
  35.   END                   ! dur avec un ACC mais enfin...
  36. ENDIF
  37. ~RSRC_GADDR(0,0,menu_ptr%)          ! cherche adresse de mon menu
  38. ~MENU_REGISTER(app_id&,my_menu$)        ! place mon nom dans le menu
  39. ' Mise en place du détournement de reset (Cookie-Jar STF)
  40. @put_reset      ! deux routines à utiliser à chaque fois,
  41. @init_tube_acc  ! et donc à mettre en bibliothéque
  42. '
  43. ' Et nous commençons la grande attente !
  44. DO
  45.   ~EVNT_MESAG(VARPTR(messagebuf&(0)))    ! attente des messages...
  46.   SELECT messagebuf&(0)
  47.   CASE 40                             ! ouverture de l'accessoire
  48.     @open_acc                         ! allons le gérer
  49.   CASE 300                            ! demande si compatible 300
  50.     @send_message(messagebuf&(1),301) ! je répond non (301)
  51.   CASE 400                            ! demande si compatible 400
  52.     @send_message(messagebuf&(1),401) ! je répond non (401)
  53.   CASE 500                            ! demande si compatible 500
  54.     @send_message(messagebuf&(1),501) ! je répond non (501)
  55.   ENDSELECT
  56. LOOP
  57. '
  58. ' Ouverture de l'accessoire. Recherche et vérification du tableau
  59. ' des APP_ID à cause d'une destruction toujours possible
  60. > PROCEDURE open_acc
  61.   LOCAL action&
  62.   @find_apid
  63.   IF a0%<>0
  64.     maxi&=DPEEK(a0%+4)
  65.     a0%=a0%+4   !saute l'en-tête
  66.     ' Recherche d'un correspondant
  67.     REPEAT
  68.       DEC maxi&         !compte un APP_ID
  69.       a0%=a0%+2
  70.       IF DPEEK(a0%)=&HFFFF OR maxi&=0
  71.         ~FORM_ALERT(1,alert3$)   ! personne ne répond
  72.       ELSE
  73.         IF DPEEK(a0%)<>app_id&   ! si ce n'est pas le notre
  74.           ' Message pour ce correspondant potentiel
  75.           @send_message(DPEEK(a0%),400)
  76.           action&=EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,VARPTR(messagebuf&(0)),500)
  77.           IF action&<>&X100000 AND messagebuf&(0)=403
  78.             ' Notre menu est accepté, envoyons son adresse
  79.             prg_id&=messagebuf&(1)
  80.             messagebuf&(0)=406
  81.             messagebuf&(1)=app_id&
  82.             messagebuf&(2)=0
  83.             LPOKE VARPTR(messagebuf&(3)),menu_ptr%
  84.             messagebuf&(5)=0
  85.             messagebuf&(6)=0
  86.             messagebuf&(7)=0
  87.             ~APPL_WRITE(prg_id&,16,VARPTR(messagebuf&(0)))
  88.             ' Puis attente de confirmation
  89.             ~EVNT_MESAG(VARPTR(messagebuf&(0)))
  90.             SELECT messagebuf&(0)
  91.             CASE 405
  92.               @main         !confirmation, menu actif->allons le gérer
  93.               maxi&=0       ! pour forcer la sortie
  94.             ENDSELECT       ! sinon bye bye...
  95.           ENDIF
  96.         ENDIF
  97.       ENDIF
  98.     UNTIL DPEEK(a0%)=&HFFFF OR maxi&=0
  99.   ENDIF
  100. RETURN
  101. '
  102. ' Routine de gestion de notre menu déroulant à l'aide
  103. ' des messages en provenance du programme principal.
  104. > PROCEDURE main
  105.   ~FORM_ALERT(1,alert1$)        ! publicité
  106.   flag_quitter!=FALSE
  107.   REPEAT
  108.     ~EVNT_MESAG(VARPTR(messagebuf&(0)))
  109.     SELECT messagebuf&(0)
  110.     CASE 407
  111.       @gere_menu
  112.       IF flag_quitter!=TRUE
  113.         @send_message(prg_id&,408)
  114.       ENDIF
  115.     CASE 409      ! le prg retire mon menu
  116.       flag_quitter!=TRUE
  117.     ENDSELECT
  118.   UNTIL flag_quitter!=TRUE
  119. RETURN
  120. '
  121. ' Gestion du menu déroulant. Classique, bien que les messages
  122. ' viennent du PRG et non pas directement du GEM!
  123. > PROCEDURE gere_menu
  124.   SELECT messagebuf&(4)
  125.   CASE about400&
  126.     ~FORM_ALERT(1,alert1$)
  127.   CASE quit400&
  128.     flag_quitter!=TRUE
  129.   CASE hello400&
  130.     ~FORM_ALERT(1,alert2$)
  131.   CASE check400&
  132.     flag_check&=BCHG(flag_check&,0)
  133.     ~MENU_ICHECK(menu_ptr%,check400&,flag_check&)
  134.   ENDSELECT
  135.   ~MENU_TNORMAL(menu_ptr%,messagebuf&(3),1)
  136. RETURN
  137. '
  138. ' Les procédures suivantes sont simplement à merger.
  139. ' Elles sont disponibles dans le dossier Biblio.
  140. > PROCEDURE init_tube_acc
  141.   '
  142.   ' Procédure d'initialisation pour accessoire
  143.   ' Fichier ACC_INIT.LST
  144.   '
  145.   cookie4&=0                    ! ne pas écraser
  146. init_tub0:
  147.   cookie1%=CVL("_TUB")          ! cookie recherché
  148.   cookie2%=VARPTR(new_jar%(0))  !
  149.   cookie3%=VARPTR(tab_tub&(0))
  150.   @cookie_jar
  151.   '
  152.   IF cookie2%<>0
  153.     IF cookie3%=VARPTR(tab_tub&(0))     ! si c'est ma liste
  154.       tab_tub&(0)=CVI("PR")     ! je met son en-tête
  155.       tab_tub&(1)=CVI("OT")
  156.       tab_tub&(2)=10      ! le nbd d'app_id quelle peut contenir
  157.       tab_tub&(3)=app_id& ! mon APP_ID
  158.       tab_tub&(4)=-1      ! et la marque de fin
  159.     ELSE
  160.       ' Vérifions le tableau Protocole en place...
  161.       IF LPEEK(cookie3%)<>CVL("PROT")
  162.         cookie4&=1      ! tableau invalide, nous
  163.         GOTO init_tub0  ! allons l'écraser...
  164.       ELSE
  165.         ' Parcourons le tableau en place pour placer
  166.         ' notre APP_ID et clore par &HFFFF
  167.         maxi&=DPEEK(cookie3%+4) ! nbr maxi d'app_id autorisés
  168.         cookie3%=cookie3%+6     ! saute l'en-tête
  169.         REPEAT
  170.           ' Nous prévoyons le cas d'ACC lancés par Multidesk
  171.           ' qui améne à avoir plusieurs fois le même APP_ID:
  172.           ' Si nous y trouvons déja le notre -> bye bye!!!
  173.           EXIT IF DPEEK(cookie3%)=app_id&
  174.           IF DPEEK(cookie3%)=&HFFFF     ! fin de la liste ?
  175.             DPOKE cookie3%,app_id&      ! donc met mon APPID
  176.             DPOKE cookie3%+2,&HFFFF     ! et l'indication de fin
  177.           ELSE
  178.             cookie3%=cookie3%+2         ! sinon passe à l'app_id
  179.             DEC maxi&                   ! suivant, et le compte
  180.           ENDIF
  181.         UNTIL DPEEK(cookie3%)=app_id& OR maxi&=0
  182.       ENDIF
  183.     ENDIF
  184.   ENDIF
  185. RETURN
  186. > PROCEDURE send_message(dest&,num&)
  187.   '
  188.   ' Pour envoyer un message à une autre application
  189.   ' Fichier SEND_MES.LST
  190.   '
  191.   messagebuf&(0)=num&           !numéro du message
  192.   messagebuf&(1)=app_id&        !mon identificateur d'application
  193.   messagebuf&(3)=0              !et tout le reste à 0
  194.   messagebuf&(4)=0
  195.   messagebuf&(5)=0
  196.   messagebuf&(6)=0
  197.   messagebuf&(7)=0
  198.   ~APPL_WRITE(dest&,16,VARPTR(messagebuf&(0)))
  199. RETURN
  200. > PROCEDURE find_apid
  201.   '
  202.   ' Recherche de la liste des APP_ID et retour de son
  203.   ' adresse dans la variable a0%
  204.   ' C'est une procédure commune aux ACCs et aux PRGs
  205.   ' Fichier TUBEFIND.LST
  206.   '
  207.   cookie1%=CVL("_TUB")
  208.   cookie2%=0
  209.   cookie3%=0
  210.   cookie4&=0
  211.   @cookie_jar
  212.   '
  213.   IF cookie2%=0 OR cookie3%=0
  214.     ~FORM_ALERT(1,alerte_tub3$)
  215.     a0%=0
  216.   ELSE
  217.     IF LPEEK(cookie3%)<>CVL("PROT")
  218.       ~FORM_ALERT(1,alerte_tub1$)
  219.       a0%=0
  220.     ELSE
  221.       a0%=cookie3%
  222.     ENDIF
  223.   ENDIF
  224. RETURN
  225. > PROCEDURE cookie_jar
  226.   '
  227.   ' Procédure permettant de lire et/ou d'écrire dans le Cookie-Jar.
  228.   ' Par simplification, il s'agit de la même routine pour ACC et PRG
  229.   ' alors qu'il aurait été possible d'en faire des différentes.
  230.   ' Fichier COOKIJAR.LST
  231.   '
  232.   LOCAL temp%,x%,cmp%
  233. cookie_jar0:
  234.   temp%=LPEEK(&H5A0)         !cherche adresse cookie-jar
  235.   ' S'il n'y a pas de boite, nous plaçons la notre
  236.   IF temp%=0
  237.     IF cookie2%<>0              ! si nous avons une boite à mettre...
  238.       SLPOKE &H5A0,cookie2%      ! adresse de celle-ci
  239.       IF cookie1%<>0            ! si nous avons un cookie...
  240.         LPOKE cookie2%,cookie1%
  241.         LPOKE cookie2%+4,cookie3%
  242.         LPOKE cookie2%+8,0
  243.         LPOKE cookie2%+12,16
  244.       ENDIF
  245.     ENDIF
  246.   ELSE     ! Il y a un Cookie-Jar
  247.     IF cookie1%<>0      ! si nous devons chercher un gateaux
  248.       cmp%=0                      ! init. compteur de Cookie
  249.       REPEAT
  250.         x%=LPEEK(temp%)           ! préléve l'identif. d'un cookie
  251.         temp%=temp%+8             ! avance sur le suivant
  252.         INC cmp%                  ! et compte ce cookie
  253.       UNTIL x%=0 OR x%=cookie1%
  254.       temp%=temp%-4               !reculons sur l'info. de ce cookie
  255.       ' Si nous avons trouvé notre cookie1
  256.       IF x%=cookie1%
  257.         IF cookie4&=0   ! si nous devons juste noter l'information,
  258.           cookie3%=LPEEK(temp%)     ! nous la notons et bye bye...
  259.         ELSE
  260.           LPOKE temp%,cookie3%      ! sinon nous la forçons
  261.         ENDIF
  262.       ELSE
  263.         ' Nous avons trouvé la fin de la boite, nous mettons
  264.         ' notre cookie, s'il reste de la place...
  265.         IF LPEEK(temps%)=0      ! précaution si nbr de slot nul,
  266.           SLPOKE &H5A0,0         ! la boite est mauvaise...
  267.           GOTO cookie_jar0
  268.         ENDIF
  269.         IF cookie3%<>0  ! si nous avons quelque chose à mettre
  270.           IF cmp%<LPEEK(temp%)             ! s'il reste de la place...
  271.             LPOKE (temp%+4),0               ! flag de fin
  272.             LPOKE (temp%+8),LPEEK(temp%)    ! transfert le nbr d'emplacement
  273.             LPOKE (temp%-4),cookie1%        ! place l'identif. de notre cookie
  274.             LPOKE (temp%),cookie3%          ! et sa valeur d'info
  275.           ELSE
  276.             ' Il n'y a pas assez de place: plaçons une plus grosse boite
  277.             IF cmp%<16 AND cookie2%<>0      ! si nous pouvons...
  278.               temp%=LPEEK(&H5A0)        ! adr ancien cookie-jar
  279.               SLPOKE &H5A0,cookie2%      ! note adr du nouveau
  280.               WHILE LPEEK(temp%)<>0
  281.                 LPOKE cookie2%,LPEEK(temp%)
  282.                 LPOKE cookie2%+4,LPEEK(temp%+4)
  283.                 temp%=temp%+8
  284.                 cookie2%=cookie2%+8
  285.               WEND
  286.               LPOKE (cookie2%),cookie1%
  287.               LPOKE (cookie2%+4),cookie3%
  288.               LPOKE (cookie2%+8),0
  289.               LPOKE (cookie2%+12),16
  290.             ELSE
  291.               ' Boite pas assez grosse ou pas de boite à mettre ...
  292.               cookie3%=0
  293.             ENDIF
  294.           ENDIF
  295.         ENDIF
  296.       ENDIF
  297.     ENDIF
  298.   ENDIF
  299.   cookie2%=LPEEK(&H5A0)
  300. RETURN
  301. > PROCEDURE put_reset
  302.   '
  303.   ' Procédure pour détourner le reset et y placer une routine
  304.   ' effaçant le contenu de $5A0 (cas d'un Cookie-Jar de STF)
  305.   ' Fichier RESET.LST
  306.   '
  307.   RESTORE asm_data
  308.   DO
  309.     READ code$
  310.     EXIT IF code$="FIN"
  311.     code$="&H"+code$
  312.     code%=VAL(code$)
  313.     asm$=asm$+MKI$(code%)
  314.   LOOP
  315.   asm%=VARPTR(asm$)
  316.   LPOKE asm%+8,LPEEK(&H426)           ! prend ancien magique
  317.   LPOKE asm%+18,LPEEK(&H42A)          ! prend ancienne routine
  318.   SLPOKE &H426,&H31415926       ! magique reset
  319.   SLPOKE &H42A,asm%
  320. RETURN
  321. asm_data:
  322. DATA 42B9,0000,05A0
  323. DATA 23FC,0000,0000,0000,0426
  324. DATA 23FC,0000,0000,0000,042A
  325. DATA 4ED6,FIN
  326.